library(tidyverse)
library(tidyboot)
library(ggplot2)
library(ggthemes)
library(knitr)
library(coda)
library(viridis)
library(here)
library(patchwork)
theme_set(theme_few())
estimate_mode <- function(s) {
  d <- density(s)
  return(d$x[which.max(d$y)])
}
hpd_upper <- function(s){
  m <- HPDinterval(mcmc(s))
  return(m["var1","upper"])
}
hpd_lower <- function(s){
  m <- HPDinterval(mcmc(s))
  return(m["var1","lower"])
}

count_summary_fn <- function(x) x %>%
  summarize(n = n()) %>%
  mutate(stat = n / sum(n))

mean_ci_funs <- list("ci_lower" = ci_lower, "mean" = mean, "ci_upper" = ci_upper)

Load human data

State

h_state <- read_csv(here("/data/clean_data_true_state.csv"))
## Parsed with column specification:
## cols(
##   id = col_character(),
##   condition_level = col_character(),
##   response = col_double(),
##   utt = col_character(),
##   exp = col_character(),
##   condition_name = col_character()
## )
h_state_summary <- h_state %>%
  rename(emo = exp, 
         state = response, 
         manipulation = condition_name, 
         manipulation_level = condition_level) %>%
  mutate(manipulation_level = ifelse(manipulation_level=="inf_goal", "inf", manipulation_level),
         manipulation_level = ifelse(manipulation_level=="soc_goal", "soc", manipulation_level))%>%
  group_by(manipulation, manipulation_level, utt, emo, state) %>%
  tidyboot(summary_function = count_summary_fn,
          statistics_functions = function(x) x %>%
          summarise(across(stat, mean_ci_funs, .names = "{.fn}")))
## `summarise()` has grouped output by 'manipulation', 'manipulation_level', 'utt', 'emo'. You can override using the `.groups` argument.
## `summarise()` has grouped output by '.id', 'manipulation', 'manipulation_level', 'utt', 'emo'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'manipulation', 'manipulation_level', 'utt', 'emo'. You can override using the `.groups` argument.

Distributions of responses

plot_state_emoIsComm <- h_state_summary[h_state_summary$manipulation == "emoIsComm_manipulation",] %>%
      ggplot(., aes( x = state, y = mean, ymin = ci_lower, ymax = ci_upper))+
      geom_col(position = position_dodge())+
      geom_linerange(position = position_dodge())+
      ggtitle("emoIsComm manipulation")+
      theme(plot.title = element_text(hjust = 0.5))+
      facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_state_goal <- h_state_summary[h_state_summary$manipulation == "goal_manipulation",] %>%
      ggplot(., aes( x = state, y = mean, ymin = ci_lower, ymax = ci_upper))+
      geom_col(position = position_dodge())+
      geom_linerange(position = position_dodge())+
      ggtitle("goal manipulation")+
      theme(plot.title = element_text(hjust = 0.5))+
      facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_state_state <- h_state_summary[h_state_summary$manipulation == "state_manipulation",] %>%
      mutate(manipulation_level = factor(manipulation_level, levels = c("bad", "no_info", "good"))) %>%
      ggplot(., aes( x = state, y = mean, ymin = ci_lower, ymax = ci_upper))+
      geom_col(position = position_dodge())+
      geom_linerange(position = position_dodge())+
      ggtitle("state manipulation")+
      theme(plot.title = element_text(hjust = 0.5))+
      facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_state_inference <- plot_state_emoIsComm + plot_state_goal + plot_state_state 
plot_state_inference
## Warning: Width not defined. Set with `position_dodge(width = ?)`

## Warning: Width not defined. Set with `position_dodge(width = ?)`

## Warning: Width not defined. Set with `position_dodge(width = ?)`

# ggsave(here(paste("/models/figures/mb7_state_inference.pdf")), width = 12, height = 6)

Goals

h_goal <- read_csv(here("/data/clean_data_goals.csv"))
## Parsed with column specification:
## cols(
##   id = col_character(),
##   condition_level = col_character(),
##   question = col_character(),
##   response = col_double(),
##   utt = col_character(),
##   exp = col_character(),
##   condition_name = col_character()
## )
h_goal_summary <- h_goal %>%
  rename(emo = exp,
         manipulation = condition_name, 
         manipulation_level = condition_level) %>%
  mutate(manipulation_level = ifelse(manipulation_level=="inf_goal", "inf", manipulation_level),
         manipulation_level = ifelse(manipulation_level=="soc_goal", "soc", manipulation_level))%>%
  group_by(manipulation, manipulation_level, utt, emo, question, response) %>%
  tidyboot(summary_function = count_summary_fn,
           statistics_functions = function(x) x %>%
           summarise(across(stat, mean_ci_funs, .names = "{.fn}")))
## `summarise()` has grouped output by 'manipulation', 'manipulation_level', 'utt', 'emo', 'question'. You can override using the `.groups` argument.
## `summarise()` has grouped output by '.id', 'manipulation', 'manipulation_level', 'utt', 'emo', 'question'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'manipulation', 'manipulation_level', 'utt', 'emo', 'question'. You can override using the `.groups` argument.
h_inf_summary <- h_goal_summary[h_goal_summary$question=="informational goal",]
h_soc_summary <- h_goal_summary[h_goal_summary$question=="social goal",]

Distributions of responses

informational goals

plot_inf_emoIsComm <- h_inf_summary[h_inf_summary$manipulation == "emoIsComm_manipulation",] %>%
      ggplot(., aes( x = response, y = mean, ymin = ci_lower, ymax = ci_upper))+
      geom_col(position = position_dodge())+
      geom_linerange(position = position_dodge())+
      ggtitle("emoIsComm manipulation")+
      xlab("inf goal") +
      theme(plot.title = element_text(hjust = 0.5))+
      facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_inf_goal <- h_inf_summary[h_inf_summary$manipulation == "goal_manipulation",] %>%
      ggplot(., aes( x = response, y = mean, ymin = ci_lower, ymax = ci_upper))+
      geom_col(position = position_dodge())+
      geom_linerange(position = position_dodge())+
      ggtitle("goal manipulation")+
      xlab("inf goal") +
      theme(plot.title = element_text(hjust = 0.5))+
      facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_inf_state <- h_inf_summary[h_inf_summary$manipulation == "state_manipulation",] %>%
      mutate(manipulation_level = factor(manipulation_level, levels = c("bad", "no_info", "good"))) %>%
      ggplot(., aes( x = response, y = mean, ymin = ci_lower, ymax = ci_upper))+
      geom_col(position = position_dodge())+
      geom_linerange(position = position_dodge())+
      ggtitle("state manipulation")+
      xlab("inf goal") +
      theme(plot.title = element_text(hjust = 0.5))+
      facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_inf_inference <- plot_inf_emoIsComm + plot_inf_state + plot_inf_goal
plot_inf_inference
## Warning: Width not defined. Set with `position_dodge(width = ?)`

## Warning: Width not defined. Set with `position_dodge(width = ?)`

## Warning: Width not defined. Set with `position_dodge(width = ?)`

# ggsave(here(paste("/models/figures/mb7_inf_inference.pdf")), width = 12, height = 6)

social goals

plot_soc_emoIsComm <- h_soc_summary[h_soc_summary$manipulation == "emoIsComm_manipulation",] %>%
      ggplot(., aes( x = response, y = mean, ymin = ci_lower, ymax = ci_upper))+
      geom_col(position = position_dodge())+
      geom_linerange(position = position_dodge())+
      ggtitle("emoIsComm manipulation")+
      xlab("soc goal") +
      theme(plot.title = element_text(hjust = 0.5))+
      facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_soc_goal <- h_soc_summary[h_soc_summary$manipulation == "goal_manipulation",] %>%
      ggplot(., aes( x = response, y = mean, ymin = ci_lower, ymax = ci_upper))+
      geom_col(position = position_dodge())+
      geom_linerange(position = position_dodge())+
      ggtitle("goal manipulation")+
      xlab("soc goal") +
      theme(plot.title = element_text(hjust = 0.5))+
      facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_soc_state <- h_soc_summary[h_soc_summary$manipulation == "state_manipulation",] %>%
      mutate(manipulation_level = factor(manipulation_level, levels = c("bad", "no_info", "good"))) %>%
      ggplot(., aes( x = response, y = mean, ymin = ci_lower, ymax = ci_upper))+
      geom_col(position = position_dodge())+
      geom_linerange(position = position_dodge())+
      ggtitle("state manipulation")+
      xlab("soc goal") +
      theme(plot.title = element_text(hjust = 0.5))+
      facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_soc_inference <- plot_soc_emoIsComm + plot_soc_goal + plot_soc_state 
plot_soc_inference
## Warning: Width not defined. Set with `position_dodge(width = ?)`

## Warning: Width not defined. Set with `position_dodge(width = ?)`

## Warning: Width not defined. Set with `position_dodge(width = ?)`

# ggsave(here(paste("/models/figures/mb7_soc_inference.pdf")), width = 12, height = 6)

Load model results

results_path <- "models/bda_results/"
model.files <- list.files(
      path = paste(here(), results_path, sep = "/"),
      pattern = "bda-M"
    )
df.m <- map_dfr(model.files, function(model.file){
    read_csv(here(paste(results_path, model.file, sep = "")),
             col_types = cols(
                      iter = col_double(),
                      model = col_character(),
                      chain = col_double(),
                      manipulation = col_character(),
                      manipulation_level = col_character(),
                      parameter = col_character(),
                      utt = col_character(),
                      emo = col_character(),
                      value = col_character(),
                      prob = col_double(),
                      score = col_double()
                    ))
})

Global parameters

df.m %>%
  filter(parameter == "parameter", is.na(emo)) %>%
  ggplot(., aes(x = prob))+
  geom_histogram(position = position_dodge())+
  facet_grid(cols = vars(utt), scales = "free_x")
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

# ggsave(here("/models/figures/mb7_global_parameters.pdf"), width = 8, height = 5)

Summary

df.m %>%
  filter(parameter == "parameter", is.na(emo)) %>%
  group_by(utt) %>%
  summarize(
    MAP = estimate_mode(prob),
    cred_upper = hpd_upper(prob),
    cred_lower = hpd_lower(prob)
  ) -> df_parameter_summary


df_parameter_summary %>%
  kable(.)
utt MAP cred_upper cred_lower
goalExp 4.585671 4.810373 0.0067195
goalScale 8.101648 94.887985 0.0002936
speakerOptimality 11.430389 18.151587 0.6330936

Prior parameters

df.m %>%
  filter(parameter == "parameter", is.na(emo) == FALSE) %>%
  ggplot(., aes(x = prob))+
  geom_histogram(position = position_dodge())+
  facet_grid(cols = vars(utt, emo), rows = vars(value), scales = "free_x")
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

# ggsave(here("/models/figures/mb7_prior_parameters.pdf"), width = 20, height = 5)

Summary

df.m %>%
  filter(parameter == "parameter", is.na(emo) == FALSE) %>%
  group_by(utt, emo, value) %>%
  summarize(
    MAP = estimate_mode(prob),
    cred_upper = hpd_upper(prob),
    cred_lower = hpd_lower(prob)
  ) %>%
  rename(prior = 'utt', level = 'emo') -> df_parameter_summary
## `summarise()` has grouped output by 'utt', 'emo'. You can override using the `.groups` argument.
df_parameter_summary %>%
  kable(.)
prior level value MAP cred_upper cred_lower
emoIsCommPrior communicative NA 0.7249253 0.9966845 0.0854412
emoIsCommPrior no_info NA 0.7970136 0.9559733 0.0218114
emoIsCommPrior noncommunicative NA 0.1965886 0.9666617 0.0454865
infGoalPrior inf mu 1.7836713 3.7539310 1.0142491
infGoalPrior inf sigma 0.8602859 2.8817960 0.1003043
infGoalPrior no_info mu 3.1976354 3.9713729 1.2396245
infGoalPrior no_info sigma 2.7304857 2.8397848 0.0205306
infGoalPrior soc mu 2.2007525 3.9384114 1.1132417
infGoalPrior soc sigma 0.7830124 2.8481489 0.0083831
socGoalPrior inf mu 2.5839419 3.9706656 1.1444114
socGoalPrior inf sigma 0.2279484 2.8426762 0.0461502
socGoalPrior no_info mu 3.1438213 3.9353185 1.1443663
socGoalPrior no_info sigma 2.7854985 2.9888604 0.1333197
socGoalPrior soc mu 3.6472665 3.8183528 1.0546376
socGoalPrior soc sigma 0.8964771 2.8320957 0.0387915
statePrior bad mu 5.5141442 5.9202755 1.1995607
statePrior bad sigma 1.4527751 2.8015206 0.0007453
statePrior good mu 3.0861868 5.8433853 1.2481192
statePrior good sigma 0.2929963 2.8938053 0.0279794
statePrior no_info mu 5.6165645 5.9832126 1.3448652
statePrior no_info sigma 0.5891282 2.8205601 0.0144962

State posterior predictives

df_state <- df.m %>%
  filter(parameter == "state") %>%
  mutate(state = as.numeric(value)) %>%
  select(-value)

df_state_summary <- df_state %>%
  group_by(manipulation, manipulation_level, utt, emo, state) %>%
  summarize(
    MAP = estimate_mode(prob),
    cred_upper = hpd_upper(prob),
    cred_lower = hpd_lower(prob)
  )
## `summarise()` has grouped output by 'manipulation', 'manipulation_level', 'utt', 'emo'. You can override using the `.groups` argument.

response distribution

plot_df_state_emoIsComm <- df_state_summary[df_state_summary$manipulation == "emoIsComm_manipulation",] %>%
      ggplot(., aes( x = state, y = MAP, ymin = cred_lower, ymax = cred_upper))+
      geom_col(position = position_dodge())+
      geom_linerange(position = position_dodge())+
      ggtitle("emoIsComm manipulation")+
      theme(plot.title = element_text(hjust = 0.5))+
      facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_df_state_goal <- df_state_summary[df_state_summary$manipulation == "goal_manipulation",] %>%
      ggplot(., aes( x = state, y = MAP, ymin = cred_lower, ymax = cred_upper))+
      geom_col(position = position_dodge())+
      geom_linerange(position = position_dodge())+
      ggtitle("goal manipulation")+
      theme(plot.title = element_text(hjust = 0.5))+
      facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_df_state_state <- df_state_summary[df_state_summary$manipulation == "state_manipulation",] %>%
      mutate(manipulation_level = factor(manipulation_level, levels = c("bad", "no_info", "good"))) %>%
      ggplot(., aes( x = state, y = MAP, ymin = cred_lower, ymax = cred_upper))+
      geom_col(position = position_dodge())+
      geom_linerange(position = position_dodge())+
      ggtitle("state manipulation")+
      theme(plot.title = element_text(hjust = 0.5))+
      facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_df_state_inference <- plot_df_state_emoIsComm + plot_df_state_goal + plot_df_state_state 
plot_state_inference # human
## Warning: Width not defined. Set with `position_dodge(width = ?)`

## Warning: Width not defined. Set with `position_dodge(width = ?)`

## Warning: Width not defined. Set with `position_dodge(width = ?)`

plot_df_state_inference # model
## Warning: Width not defined. Set with `position_dodge(width = ?)`

## Warning: Width not defined. Set with `position_dodge(width = ?)`

## Warning: Width not defined. Set with `position_dodge(width = ?)`

### join with human data

md_state <- left_join(
  df_state_summary, h_state_summary
)
## Joining, by = c("manipulation", "manipulation_level", "utt", "emo", "state")

posterior predictive scatterplots

correlation table

md_state %>%
  unite("utt_emo", utt, emo) %>%
  mutate(
    mean = ifelse(is.na(mean), 0, mean),
    ci_lower = ifelse(is.na(ci_lower), 0, ci_lower),
    ci_upper = ifelse(is.na(ci_upper), 0, ci_upper),
    state = factor(state)
  ) %>%
  #group_by(model) %>%
  summarize(
    mse = mean((MAP - mean)^2),
    r = cor(MAP, mean),
    r2 = r^2
  ) -> md_state_corr_table
## `summarise()` has grouped output by 'manipulation'. You can override using the `.groups` argument.
#write_csv(md_state_corr_table, "../state_correlations.csv")

md_state_corr_table %>%
  kable()
manipulation manipulation_level mse r r2
emoIsComm_manipulation comm 0.0144897 0.7520564 0.5655888
emoIsComm_manipulation no_info 0.0138991 0.8008296 0.6413281
emoIsComm_manipulation non_comm 0.0209157 0.7501337 0.5627006
goal_manipulation inf 0.0162781 0.7735252 0.5983412
goal_manipulation no_info 0.0180507 0.7587487 0.5756995
goal_manipulation soc 0.0165543 0.7944124 0.6310910
state_manipulation bad 0.0635281 0.1146423 0.0131429
state_manipulation good 0.0513105 0.1450050 0.0210265
state_manipulation no_info 0.0509719 0.2007212 0.0402890 
md_state %>%
  unite("utt_emo", utt, emo) %>%
  mutate(
    mean = ifelse(is.na(mean), 0, mean),
    ci_lower = ifelse(is.na(ci_lower), 0, ci_lower),
    ci_upper = ifelse(is.na(ci_upper), 0, ci_upper),
    state = factor(state)
  ) %>%
  ggplot(., aes( x = MAP, xmin = cred_lower, xmax = cred_upper,
                      y = mean, ymin = ci_lower, ymax = ci_upper,
                 shape = utt_emo, color = state))+
  geom_abline(intercept = 0, slope = 1, alpha = 0.3, linetype = 2)+
  geom_linerange()+
  geom_text(data = md_state_corr_table, x = 0.15, y = 0.93,
            aes(label = paste("r=", round(r, 2), sep= "")),
            inherit.aes = F)+
  ggstance::geom_linerangeh()+
  geom_point()+
  scale_color_viridis(discrete = T)+
  #xlim(0, 1)+
  #ylim(0, 1)+
  coord_fixed()+
  facet_wrap(vars(manipulation, manipulation_level), ncol = 3)+
  scale_y_continuous(limits = c(0, 1), breaks = c(0, 1))+
  scale_x_continuous(limits = c(0, 1), breaks = c(0, 1))+
  theme(legend.position = 'right')+
  labs(
    x = "Model Predicted Probability",
    y = "Human Proportion Selected"
  )

# ggsave(filename = "bda_results/figs/bda_scatters_state_21models_cogsci.pdf", width = 18, height = 5)

Goal posterior predictives

df_goal <- df.m %>%
  filter(parameter %in% c("socGoal", "infGoal")) %>%
  mutate(rating = as.numeric(value)) %>%
  select(-value)

df_goal_summary <- df_goal %>%
  group_by(manipulation, manipulation_level, parameter, utt, emo, rating) %>%
  summarize(
    MAP = estimate_mode(prob),
    cred_upper = hpd_upper(prob),
    cred_lower = hpd_lower(prob)
  )
## `summarise()` has grouped output by 'manipulation', 'manipulation_level', 'parameter', 'utt', 'emo'. You can override using the `.groups` argument.
df_inf_summary <- df_goal_summary[df_goal_summary$parameter=="infGoal",]
df_soc_summary <- df_goal_summary[df_goal_summary$parameter=="socGoal",]

Distribution of responses

informational goals

plot_df_inf_emoIsComm <- df_inf_summary[df_inf_summary$manipulation == "emoIsComm_manipulation",] %>%
      ggplot(., aes( x = rating, y = MAP, ymin = cred_lower, ymax = cred_upper))+
      geom_col(position = position_dodge())+
      geom_linerange(position = position_dodge())+
      ggtitle("emoIsComm manipulation")+
      xlab("inf goal") +
      theme(plot.title = element_text(hjust = 0.5))+
      facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_df_inf_goal <- df_inf_summary[df_inf_summary$manipulation == "goal_manipulation",] %>%
      ggplot(., aes( x = rating, y = MAP, ymin = cred_lower, ymax = cred_upper))+
      geom_col(position = position_dodge())+
      geom_linerange(position = position_dodge())+
      ggtitle("goal manipulation")+
      xlab("inf goal") +
      theme(plot.title = element_text(hjust = 0.5))+
      facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_df_inf_state <- df_inf_summary[df_inf_summary$manipulation == "state_manipulation",] %>%
      mutate(manipulation_level = factor(manipulation_level, levels = c("bad", "no_info", "good"))) %>%
      ggplot(., aes( x = rating, y = MAP, ymin = cred_lower, ymax = cred_upper))+
      geom_col(position = position_dodge())+
      geom_linerange(position = position_dodge())+
      ggtitle("state manipulation")+
      xlab("inf goal") +
      theme(plot.title = element_text(hjust = 0.5))+
      facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_df_inf_inference <- plot_df_inf_emoIsComm + plot_df_inf_state + plot_df_inf_goal
plot_inf_inference # human
## Warning: Width not defined. Set with `position_dodge(width = ?)`

## Warning: Width not defined. Set with `position_dodge(width = ?)`

## Warning: Width not defined. Set with `position_dodge(width = ?)`

plot_df_inf_inference # model
## Warning: Width not defined. Set with `position_dodge(width = ?)`

## Warning: Width not defined. Set with `position_dodge(width = ?)`

## Warning: Width not defined. Set with `position_dodge(width = ?)`

# ggsave(here(paste("/models/figures/mb7_inf_inference.pdf")), width = 12, height = 6)

social goals

plot_df_soc_emoIsComm <- df_soc_summary[df_soc_summary$manipulation == "emoIsComm_manipulation",] %>%
      ggplot(., aes( x = rating, y = MAP, ymin = cred_lower, ymax = cred_upper))+
      geom_col(position = position_dodge())+
      geom_linerange(position = position_dodge())+
      ggtitle("emoIsComm manipulation")+
      xlab("soc goal") +
      theme(plot.title = element_text(hjust = 0.5))+
      facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_df_soc_goal <- df_soc_summary[df_soc_summary$manipulation == "goal_manipulation",] %>%
      ggplot(., aes( x = rating, y = MAP, ymin = cred_lower, ymax = cred_upper))+
      geom_col(position = position_dodge())+
      geom_linerange(position = position_dodge())+
      ggtitle("goal manipulation")+
      xlab("soc goal") +
      theme(plot.title = element_text(hjust = 0.5))+
      facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_df_soc_state <- df_soc_summary[df_soc_summary$manipulation == "state_manipulation",] %>%
      mutate(manipulation_level = factor(manipulation_level, levels = c("bad", "no_info", "good"))) %>%
      ggplot(., aes( x = rating, y = MAP, ymin = cred_lower, ymax = cred_upper))+
      geom_col(position = position_dodge())+
      geom_linerange(position = position_dodge())+
      ggtitle("state manipulation")+
      xlab("soc goal") +
      theme(plot.title = element_text(hjust = 0.5))+
      facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_df_soc_inference <- plot_df_soc_emoIsComm + plot_df_soc_goal + plot_df_soc_state 
plot_soc_inference #human
## Warning: Width not defined. Set with `position_dodge(width = ?)`

## Warning: Width not defined. Set with `position_dodge(width = ?)`

## Warning: Width not defined. Set with `position_dodge(width = ?)`

plot_df_soc_inference # model
## Warning: Width not defined. Set with `position_dodge(width = ?)`

## Warning: Width not defined. Set with `position_dodge(width = ?)`

## Warning: Width not defined. Set with `position_dodge(width = ?)`

# ggsave(here(paste("/models/figures/mb7_soc_inference.pdf")), width = 12, height = 6)

join with human data

md_goals <- left_join(
  df_goal_summary %>%
    mutate(question = factor(parameter, levels = c("infGoal", "socGoal"),
                            labels = c("informational goal", "social goal"))),
  h_goal_summary %>% rename(rating = response)
)
## Joining, by = c("manipulation", "manipulation_level", "utt", "emo", "rating", "question")

correlation table

md_goals %>%
  unite("utt_emo", utt, emo) %>%
  mutate(
    mean = ifelse(is.na(mean), 0, mean),
    ci_lower = ifelse(is.na(ci_lower), 0, ci_lower),
    ci_upper = ifelse(is.na(ci_upper), 0, ci_upper)
  ) %>%
  #group_by(model, question) %>%
  group_by(manipulation, manipulation_level, question) %>%
  summarize(
    n = n(),
    mse = mean((MAP - mean)^2),
    r = cor(MAP, mean),
    r2 = r^2
  ) -> md_goal_corr_table
## `summarise()` has grouped output by 'manipulation', 'manipulation_level'. You can override using the `.groups` argument.
# write_csv(md_goal_corr_table, "../goal_correlations.csv")

md_goal_corr_table %>%
  kable()
manipulation manipulation_level question n mse r r2
emoIsComm_manipulation comm informational goal 16 0.0182186 0.5912451 0.3495707
emoIsComm_manipulation comm social goal 16 0.0127072 0.7055679 0.4978261
emoIsComm_manipulation no_info informational goal 16 0.0199157 0.7789773 0.6068056
emoIsComm_manipulation no_info social goal 16 0.0118767 0.7295013 0.5321721
emoIsComm_manipulation non_comm informational goal 16 0.0243683 0.7732777 0.5979585
emoIsComm_manipulation non_comm social goal 16 0.0133026 0.6673374 0.4453392
goal_manipulation inf informational goal 16 0.0996975 -0.2213533 0.0489973
goal_manipulation inf social goal 16 0.0495317 0.2082617 0.0433729
goal_manipulation no_info informational goal 16 0.0548506 0.2754521 0.0758739
goal_manipulation no_info social goal 16 0.0189783 0.6504116 0.4230352
goal_manipulation soc informational goal 16 0.0645134 0.0706625 0.0049932
goal_manipulation soc social goal 16 0.0734896 -0.0167098 0.0002792
state_manipulation bad informational goal 16 0.0320681 0.5955565 0.3546876
state_manipulation bad social goal 16 0.0157302 0.6195009 0.3837813
state_manipulation good informational goal 16 0.0198226 0.5380156 0.2894608
state_manipulation good social goal 16 0.0139533 0.7210089 0.5198538
state_manipulation no_info informational goal 16 0.0346837 0.5641608 0.3182774
state_manipulation no_info social goal 16 0.0169586 0.6769806 0.4583028

posterior predictive scatterplot

informational goal

md_goals %>%
  filter(parameter=="infGoal") %>%
  unite("utt_emo", utt, emo) %>%
  mutate(
    mean = ifelse(is.na(mean), 0, mean),
    ci_lower = ifelse(is.na(ci_lower), 0, ci_lower),
    ci_upper = ifelse(is.na(ci_upper), 0, ci_upper),
    rating = factor(rating)
  ) %>%
  ggplot(., aes( x = MAP, xmin = cred_lower, xmax = cred_upper,
                      y = mean, ymin = ci_lower, ymax = ci_upper,
                 shape = utt_emo, color = rating))+
  geom_abline(intercept = 0, slope = 1, alpha = 0.3, linetype = 2)+
  geom_linerange()+
  geom_text(data = md_goal_corr_table, x = 0.15, y = 0.96,
            aes(label = paste("r=", round(r, 2), sep= "")),
            inherit.aes = F)+
  ggstance::geom_linerangeh()+
  geom_point()+
  coord_fixed()+
  #facet_grid(question~model)+
  facet_wrap(vars(manipulation, manipulation_level, nrows = 3))+
  scale_y_continuous(limits = c(0, 1), breaks = c(0, 1))+
  scale_x_continuous(limits = c(0, 1), breaks = c(0, 1))+
  theme(legend.position = 'right')+
  labs(
    x = "Model Predicted Probability",
    y = "Human Proportion Selected"
  )

#ggsave(filename = "bda_results/figs/bda_scatters_goal_21models_cogsci.pdf", width = 24, height = 4.5)

social goal

md_goals %>%
  filter(parameter=="socGoal") %>%
  unite("utt_emo", utt, emo) %>%
  mutate(
    mean = ifelse(is.na(mean), 0, mean),
    ci_lower = ifelse(is.na(ci_lower), 0, ci_lower),
    ci_upper = ifelse(is.na(ci_upper), 0, ci_upper),
    rating = factor(rating)
  ) %>%
  ggplot(., aes( x = MAP, xmin = cred_lower, xmax = cred_upper,
                      y = mean, ymin = ci_lower, ymax = ci_upper,
                 shape = utt_emo, color = rating))+
  geom_abline(intercept = 0, slope = 1, alpha = 0.3, linetype = 2)+
  geom_linerange()+
  geom_text(data = md_goal_corr_table, x = 0.15, y = 0.96,
            aes(label = paste("r=", round(r, 2), sep= "")),
            inherit.aes = F)+
  ggstance::geom_linerangeh()+
  geom_point()+
  coord_fixed()+
  #facet_grid(question~model)+
  facet_wrap(vars(manipulation, manipulation_level, nrows = 3))+
  scale_y_continuous(limits = c(0, 1), breaks = c(0, 1))+
  scale_x_continuous(limits = c(0, 1), breaks = c(0, 1))+
  theme(legend.position = 'right')+
  labs(
    x = "Model Predicted Probability",
    y = "Human Proportion Selected"
  )